(ns ^{:doc "The module for generating actual web responses
           from templates, snippets, and hiccup."}
    clj.jtacck.web.templates
  (:use	[hiccup.core :only [html]]
	[ring.util.response :only [status
				   resource-response
				   response
				   redirect]]
	[incanter.core :only [save]]
	[incanter.charts :only [histogram]]
	[clj.jtacck.db.routing :only [get-shipping-etas
				      get-item-etas]]
	[clojure.contrib.json :only [read-json]])
  (:require [net.cgrand.enlive-html :as enlive]
	    [clj.jtacck.db.core :as db]
	    [clj.jtacck.cache :as cache]
	    [clj.jtacck.logging :as log]
	    [clojure.contrib.pprint :as pprint])
  (:import (java.io ByteArrayOutputStream
                    ByteArrayInputStream)))

(def ^{:private true} public-root "web/public")
(def ^{:private true} cache-replacement-interval (* 1000 60))
(def ^{:private true} user-types {:admin 1
				  :client-admin 2
				  :lab 3
				  :client 4
				  :courier 5})

;;; Error pages.
(enlive/deftemplate access-denied-template "web/403.html"
  [file]
  [:span#file] (enlive/content (str file)))
(enlive/deftemplate not-found-template "web/404.html"
  [file]
  [:span#file] (enlive/content (str file)))
(defn access-denied [file]
  (status (response (access-denied-template file)) 403))
(defn not-found [file]
  (status (response (not-found-template file)) 404))


(defn- html-resources
  "Returns the concatenation of html resources from the given files
  seq.  Will unwrap each resource to obtain the body contents of each
  file."
  [files]
  (mapcat (comp (partial map enlive/unwrap)
		#(enlive/select % [:body])
		enlive/html-resource
		(partial str "web/snippets/")) files))

(defn- generate-tr-tags
  "Given a collection of collections, returns a coll of tr nodes, one
  per coll where each tr contains an ordered set of td tags, one for
  each element in the coll.

  Default class for the tr is \"delete\"."
  ([coll]
     (generate-tr-tags coll "delete"))
  ([coll tr-class]
     (enlive/html-snippet
      (html
       (for [row coll]
	 [:tr {:class (str tr-class)}
	  (for [el row] (when el [:td el]))])))))

(defn- get-user-type-options
  "Returns a collection of option nodes for use within a select.
  There is one option per user-type in the database with a value of
  its id and a content of the user-type's name."
  []
  (enlive/html-snippet
   (html
    (for [{id :type_id
	   name :name} (db/get-user-types)]
      [:option {:value (str id)} name]))))

(defn- get-client-site-options
  "Returns a collection of option nodes for use within a select.
  There is one option per client-site in the database with a value of
  its id and a content of the client-site's name + its hospital name."
  []
  (enlive/html-snippet
   (html
    (for [{id :client_id
	   name :name
	   {hospital :name} :hospital} (db/get-all-client-sites)]
      [:option {:value (str id)} (str hospital " :: " name)]))))

(defn- get-courier-options
  "Returns a collection of option nodes for use within a select.
  There is one option per courier in the database with a value of
  its username and a content of their name."
  []
  (enlive/html-snippet
   (html
    (for [{{:keys [username fname lname]} :user} (db/get-couriers)]
      [:option {:value username} (str lname ", " fname)]))))

(defn- get-courier-options
  "Returns a collection of option nodes for use within a select.
  There is one option per courier in the database with a value of
  its username and a content of their name."
  []
  (enlive/html-snippet
   (html
    (for [{{:keys [username fname lname]} :user} (db/get-couriers)]
      [:option {:value username} (str lname ", " fname)]))))

(defn- get-hospital-options
  "Returns a collection of option nodes for use within a select.
  There is one option per hospital in the database with a value of its
  id and a content of its name."
  []
  (enlive/html-snippet
   (html
    (for [{:keys [hospital_id name]} (db/get-all-hospitals)]
      [:option {:value (str hospital_id)} name]))))

(defn- get-tab-buttons
  "Retrieve a list a HTML nodes appropriate to insert into the tab
  menu for the site.  Only the appropriate tabs for the given user
  will be there."
  [user-info]
  (let [user-type (get-in user-info [:type :type_id])
	files []
	files (if (= (:client user-types) user-type)
		(cons "addTabClient.html" files)
		files)
	files (if (= (:admin user-types) user-type)
		(cons "addTabAdmin.html" files)
		files)
	files (if (= (:lab user-types) user-type)
		(cons "addTabLab.html" files)
		files)]
    (map #(map enlive/unwrap %) (html-resources files))))

(defn- get-tab-contents
  "Retrieve a list a HTML nodes appropriate to insert into the
  contents for the site, matching the get-tab-buttons function.  Only
  the appropriate tabs for the given user will be there."
  [user-info]
  (let [user-type (get-in user-info [:type :type_id])
	files []
	files (if (= (:client user-types) user-type)
		(cons "tabContentClient.html" files)
		files)
	files (if (= (:admin user-types) user-type)
		(cons "tabContentAdmin.html" files)
		files)
	files (if (= (:lab user-types) user-type)
		(cons "tabContentLab.html" files)
		files)]
    (html-resources files)))

(defn- get-routes-table
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  routes tables.  The table will be join on couriers and their routes
  so there will be a row for each step of a courier's route."
  []
  (generate-tr-tags
   (for [[courier route] (db/get-routes)]
     [courier [:ol
	       (for [{site-name :name
		      {hospital-name :name
		       address :address} :hospital} route]
		 [:li (str hospital-name " :: " site-name)])]])
   ""))

(defn- get-starting-checklist-table
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  starting checklist table."
  []
  (generate-tr-tags (map list (db/get-starting-checklist))))

(defn- get-ending-checklist-table
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  ending checklist table."
  []
  (generate-tr-tags (map list (db/get-ending-checklist))))

(defn- get-specimen-list
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  specimen tables.  Only the given user's specimen will be listed. If
  the user is admin-level, everything is emitted."
  [user-info]
  (let [shipping-etas (get-shipping-etas)
	user-can-see? (fn [[shipping-info _]]
			(or (< (get-in user-info [:type :type_id])
			       (:client user-types)) ; If less, then they're admin/lab
			    (= (:username user-info)
			       (get-in shipping-info [:shipper :username]))))
	contents-to-tbl (fn [contents]
			  (html
			   (interpose
			    [:br]
			    (for [{:keys [name capColor]} contents]
			      [:span (str name " -- " capColor)]))))
	item-to-row (fn [[{{:keys [barcode
				  description
				  requirements
				  contents]} :specimen
				  {status :name
				   status-id :status_id} :status
				  {{{origin :name} :hospital} :site} :shipper
				  {destination :name} :destination
				  {{courier :username} :user} :courier}
			 eta]]
		     [(str barcode)
		      (contents-to-tbl contents)
		      (when (= (get-in user-info [:type :type_id]) (:lab user-types))
			origin)
		      (if (= status-id 3) "-" (str eta))
		      status
		      description
		      requirements
		      (when (= (get-in user-info [:type :type_id]) (:lab user-types))
			(or courier "-"))])]
    (generate-tr-tags (map item-to-row (filter user-can-see? shipping-etas)))))

(defn- get-users-list
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  user tables."
  []
  (letfn [(user-to-row [{{{hospital :name} :hospital} :site
			{user-type :name} :type
			:keys [username fname lname]}]
		       [username fname lname user-type hospital])]
    (generate-tr-tags (map user-to-row (db/get-all-users)))))

(defn- get-hospital-list
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  hospital tables."
  []
  (generate-tr-tags (map (fn [{:keys [name address]}]
			   [name address])
			 (db/get-all-hospitals))))

(defn- get-client-site-list
  "Retrieve a list a HTML tr tags appropriate to insert into the site
  client site tables."
  []
  (generate-tr-tags (map (fn [{:keys [name phone_number
				      instructions]
			       {hospital :name} :hospital}]
			   [name hospital phone_number
			    [:ol
			     (map #(-> [:li %]) instructions)]])
			 (db/get-all-client-sites))))

; The main page with all of its tables filled in.
(enlive/deftemplate index-page "web/index.html"
  [user-info]
  [:span#currentUser] (enlive/content
		       (str (:lname user-info) ", " (:fname user-info)
			    " -- " (get-in user-info [:site :name])))
  [:ul#tabElements] (enlive/append
		     (get-tab-buttons user-info)) ; Add buttons for each tab
  [:div#tabs] (enlive/append
	       (get-tab-contents user-info)) ; Add each tab content
  [:#clientTableBody] (enlive/append ; Specimen tables (client and lab)
		       (get-specimen-list user-info))
  [:#labTableBody] (enlive/append
		    (get-specimen-list user-info))
  [:#userTableBody] (enlive/append  ; User tables
		     (get-users-list))
  [:#hospitalTableBody] (enlive/append  ; Hospital table
			 (get-hospital-list))
  [:#clientSiteTableBody] (enlive/append ; Client-site list
			   (get-client-site-list))
  [:#routeTableBody] (enlive/append (get-routes-table))
  [:#sCheckListTableBody] (enlive/append
			   (get-starting-checklist-table))
  [:#eCheckListTableBody] (enlive/append
			   (get-ending-checklist-table))
  [:select#cType] (enlive/append (get-user-type-options)) ; Form inputs
  [:select#dest] (enlive/append (get-client-site-options))
  [:select#siteId] (enlive/append (get-client-site-options))
  [:select#pointD] (enlive/append (get-client-site-options))
  [:select#hID] (enlive/append (get-hospital-options))
  [:select#rName] (enlive/append (get-courier-options))
  [:?php] nil ; Remove PHP tags
  [enlive/comment-node] nil) ; Remove comments 

(defn get-graph
  "Returns a web response for the lab graph PNG showing ETAs for all
  specimen."
  []
  (letfn [(make-response [graph-bytes]
			 {:headers {"Content-Type"
				    "image/png"
				    "Cache-Control"
				    "private,no-cache,no-store"}
			  :status 200
			  :body (ByteArrayInputStream. graph-bytes)})]
    (if-let [cached-bytes (cache/retrieve-from-cache ::lab-graph-bytes)]
      (make-response cached-bytes)
      (let [items (filter pos? (get-item-etas))
	    items (if (empty? items) [-1] items)
	    chart (histogram		  ; Compute graph fresh	   
		   items
		   :x-label "ETA (minutes)"
		   :y-label "# of Specimen Items")
	    out-stream (ByteArrayOutputStream.)]
	(save chart out-stream)
	(make-response                    ; Cache newly computed graph
	 (cache/add-to-cache ::lab-graph-bytes
			     (.toByteArray out-stream)
			     cache-replacement-interval))))))


;;; Dynamic pages

(defn login-page
  "A login page.  Either just display the static html page on no
  parameters or login if given a session store, username, and
  password. If the credentials aren't valid, an error page will
  be displayed."
  ([]
     (resource-response "login.html" {:root public-root}))
  ([session username password]
     (if-let [user-info (db/get-user-info username password)]
       (-> (redirect "/")
	   (assoc :session session)
	   (assoc-in [:session :user-info] user-info))
       "Username/Password combination unknown.")))


;;; Form post pages

(defn add-shipment-page
  "The POST page for adding a shipment.  The first parameter is a
  destructuring of the HTTP parameters and the second parameter is the
  current session store."
  [{:keys [barcode
	   dest
	   itemList
	   description
	   requirement]
    :or {description ""
	 requirement ""
	 itemList ""}}
   {{:keys [username]} :user-info}]
  (try
    (let [items-json-str (if (empty? (.trim itemList)) "[]" itemList)
	  items-vec (read-json items-json-str false)
	  items-map (apply merge-with concat
			   (map (fn [[k v]] {k [v]})
				items-vec))
	  ; dest-id (Integer/parseInt dest) ; TODO Allow different destinations
	  ]
      (if (db/add-shipping-info barcode
				requirement
				description
				items-map
				username
				2 ; Hardcoded lab id
				)
	(html [:h1 "Success!!!"])
	(status (response (html [:h1 "Failure!!!"])) 400)))
    (catch NumberFormatException exn
      (log/warning (str exn))
      (status (response (html [:h1 "Bad adding of specimen!"]
			      [:p "Barcode and destination must be integers:"
			       [:pre (.getMessage exn)]])) 400))
    (catch Exception exn
      (log/warning (str exn))
      (status (response (html [:h1 "Bad adding of specimen!"]
			      [:p [:pre (str "Exception: " exn)]])) 400))))

(defn add-user-page
  "The POST page for adding a user.  The first parameter is a
  destructuring of the HTTP parameters and the second parameter is the
  current session store."
  [{:keys [username
	   password
	   fName
	   lName
	   cType
	   siteID]}
   {{{user-type :type_id} :type} :user-info}]
  (if (or (= user-type (:client-admin user-types))
	  (= user-type (:admin user-types)))
    (try
      (let [new-user-type (Integer/parseInt cType)
	    site-id (Integer/parseInt siteID)]
	(if (db/add-user username password fName lName site-id new-user-type)
	  (html [:h1 "Success!!!"])
	  (status (response (html [:h1 "Failure!!!"])) 400)))
      (catch NumberFormatException exn
	(log/warning (str exn))
	(status (response (html [:h1 "Bad adding of user!"]
				[:p "User type and site-id must be integers:"
				 [:pre (.getMessage exn)]])) 400))
      (catch Exception exn
	(log/warning (str exn))
	(status (response (html [:h1 "Bad adding of user!"]
				[:p [:pre (str "Exception: " exn)]])) 400)))
    (status (response (str "Improper user type: " user-type)) 400)))

(defn set-route-page
  "The POST page for adding a route.  The first parameter is a
  destructuring of the HTTP parameters and the second parameter is the
  current session store."
  [{:keys [routeName ; Is actually a username with a bad name.
	   routeDestinations]}
   {{{user-type :type_id} :type} :user-info}]
  (let [destinations (read-json routeDestinations false)
	route (map #(Integer/parseInt %) destinations)]
    (if (db/set-route routeName route)
      (html [:h1 "Success!!!"])
      (status (response (html [:h1 "Failure!!!"])) 400))))

(defn lab-barcode-scan-page
  "The POST page for the lab checking in an arrived package.  The
  first parameter is a destructuring of the HTTP parameters and the
  second parameter is the current session store."
  [{:keys [labScanBarcode]}
   {{{user-type :type_id} :type} :user-info}]
  (let [barcode (.trim labScanBarcode)]
    (if (and (= user-type (:lab user-types))
	     (db/check-in-specimen labScanBarcode))
      (html [:h1 "Success!!!"])
      (status (response (html [:h1 "Failure!!!"])) 400))))

(defn add-client-site-page
  "The POST page for the lab checking in an arrived package.  The
  first parameter is a destructuring of the HTTP parameters and the
  second parameter is the current session store."
  [{:keys [siteName hID hPhone instList] :as params}
   {{{user-type :type_id} :type} :user-info}]
  (let [id (Integer/parseInt hID)
	instructions (read-json instList false)]
    (if (and (isa? (class instructions) java.util.List)
	     (or (= user-type (:client-admin user-types))
		 (= user-type (:admin user-types)))
	     (db/add-client-site siteName id instructions hPhone))
      (html [:h1 "Success!!!"])
      (status (response (html [:h1 "Failure!!!"])) 400))))

(defn add-hospital-page
  "The POST page for the admin adding a new hospital.  The first
  parameter is a destructuring of the HTTP parameters and the second
  parameter is the current session store."
  [{:keys [hName hAddress] :as params}
   {{{user-type :type_id} :type} :user-info}]
  (if (and (or (= user-type (:client-admin user-types))
	       (= user-type (:admin user-types)))
	   (db/add-hospital hName hAddress))
    (html [:h1 "Success!!!"])
    (status (response (html [:h1 "Failure!!!"])) 400)))

(defn set-starting-checklist-page
  "The POST page for setting the couriers' starting checklist.  The
  first parameter is a destructuring of the HTTP parameters and the
  second parameter is the current session store."  
  [{:keys [checklist]}
   {{{user-type :type_id} :type} :user-info}]
  (let [checklist (read-json checklist false)]
    (if (and (isa? (class checklist) java.util.List)
	     (or (= user-type (:client-admin user-types))
		 (= user-type (:admin user-types)))
	     (db/set-starting-checklist checklist))
      (html [:h1 "Success!!!"])
      (status (response (html [:h1 "Failure!!!"])) 400))))

(defn set-ending-checklist-page
  "The POST page for setting the couriers' ending checklist.  The
  first parameter is a destructuring of the HTTP parameters and the
  second parameter is the current session store."  
  [{:keys [checklist]}
   {{{user-type :type_id} :type} :user-info}]
  (let [checklist (read-json checklist false)]
    (if (and (isa? (class checklist) java.util.List)
	     (or (= user-type (:client-admin user-types))
		 (= user-type (:admin user-types)))
	     (db/set-ending-checklist checklist))
      (html [:h1 "Success!!!"])
      (status (response (html [:h1 "Failure!!!"])) 400))))


(defn get-client-checklist-table
  "Retrieve HTML tr tags appropriate to insert into the site checklist
  table for the given client-site id.  The first parameter is a
  destructuring of the HTTP parameters and the second parameter is the
  current session store."
  [{:keys [clientSiteId]}
   {{{user-type :type_id} :type} :user-info}]
  (let [client-site-id (Integer/parseInt clientSiteId)
	checklist (db/get-client-checklist client-site-id)]
    (if checklist
      (generate-tr-tags (map list checklist))
      (status (response (html [:h1 "Failure!!!"])) 400))))